﻿(*******************************************************************************
* UOfficeExport v1.0 written by James Von (jamesvon@163.com) *******************
********************************************************************************
* TOfficeExport                                                                *
*------------------------------------------------------------------------------*
*     可以根据用户调用的模板或文件自动启用Excel或Word
*==============================================================================*
* 使用说明
*==============================================================================*
var
  VonOffice: TOfficeExport;
begin
  VonOffice:= TOfficeExport.OfficeExport(AFilename); //系统会根据文件后缀自动启用Word或Excel
  VonOffice.RegTable(<Prefix>, <DataSet>);           //注册一个数据库查询结果集
  VonOffice.RegData(<Prefix>, <Data>);               //注册一个 TVonTable 数据集
  VonOffice.RegCommand([<cmd_name>,[param]..[param]])//注册一个执行命令
  VonOffice.Execute;                                 //执行命令，完成数据输出
  VonOffice.Free;
end;
*------------------------------------------------------------------------------*
* <cmd_name> 说明
*------------------------------------------------------------------------------*
* ['WHILE',<Prefix>,<condition>]                //循环开始
* ['LOOP',<condition>]                          //循环结束
* ['WRITE',<prefix>,<page>,<exporttablekind>]   //写数据
* ['COPY',<copykind>,<page>,<params>]           //复制一个区域或页面到置顶页面

* Excel 命令集合 --------------------------------------------------------------*
* ['INSROW',<page>,<row>,<count>]               //插入行
* ['INSCOL',<page>,<col>,<count>]               //插入列
* ['DELROW',<page>,<row>,<count>]               //删除行
* ['DELCOL',<page>,<col>,<count>]               //删除列
*                                       //
*------------------------------------------------------------------------------*
* <condition>: NEOF=not EOF, NBOF=not BOF, BOF=BOF, EOF=BOF,
*              数字=循环次数，循环次数变量名为LOOPID(n=循环层数)
* <copykind>: HRANG=水平区域复制，后面参数为RECT四点位置即 <page>,'A2','O10'
*             VRANG=水平区域复制，后面参数为RECT四点位置即 <page>,'A2','O10'
*             HPAGE=水平单页复制，后面参数为复制页页码 <page>
*             VPAGE=垂直单页复制，后面参数为复制页页码 <page>
*------------------------------------------------------------------------------*
  with TOfficeExport.OfficeExport(GetTemplateFilename('装炉顺序表')) do try
    RegTable('B', DQLoadTable);
    RegTable('C', DQItem);
    RegTable('D', DQItem);
    DQLoadTable.First;
    DQItem.First;
    RegCommand(['WHILE', 'B', 'NEOF']);
    RegCommand(['  COPY', 'VPAGE', '1', '2']);
    RegCommand(['  WRITE', 'B', '1', 'ONLY']);
    RegCommand(['  WHILE', 'C', '1', 'NEOF']);
    RegCommand(['    WRITE', 'C', '1', 'EROW']);
    RegCommand(['    MOVE', 'D', 'FIRST']);
    RegCommand(['    WRITE', 'D', '1', 'EROW']);
    RegCommand(['  LOOP']);
    RegCommand(['  MOVE', 'B', 'NEXT']);
    RegCommand(['LOOP']);
    Execute;
    FilePath:= FThDB.AppPath + 'TEMP\';
    SaveFile(FilePath + Filename);
  finally
    Free;
  end;
*------------------------------------------------------------------------------*
  with ExportTemplate('钢管出库单') do try
    RegTable('O', DQOut);
    Execute;
    Print;
  finally
    Free;
  end;
*******************************************************************************)
unit UOfficeExport;

interface

uses
  winapi.Windows, winapi.Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, winapi.ShellAPI, ComCtrls, ImgList, OleCtrls, SHDocVw,
  DB, data.win.ADODB, OLE_Excel_TLB, OLE_Word_TLB, UVonClass, UVonLog;

type
  /// <summary>信息表类型</summary>
  /// <param name="ETK_ONLY">单一显示数据源</param>
  /// <param name="ETK_ROWS">多行填充数据源</param>
  /// <param name="ETK_COLS">多列填充数据源</param>
  /// <param name="ETK_EROW">多行扩展数据源</param>
  /// <param name="ETK_ECOL">多列扩展数据源</param>
  /// <param name="ETK_PAGE">多页显示数据源</param>
  /// <param name="ETK_RBLK">母页行段数据源</param>
  /// <param name="ETK_CBLK">母页列段数据源</param>
  EExportTableKind = (ETK_ONLY, ETK_ROWS, ETK_COLS, ETK_EROW, ETK_ECOL, ETK_PAGE, ETK_RBLK, ETK_CBLK);

  TOfficeExport = class
  private
    /// <summary>数据列表，value值为@的表示数数据库类型数据源</summary>
    FRegList: TStringList;
    /// <summary>命令集合</summary>
    FCommandList: TVonArraySetting;
    /// <summary>内部用循环变量集合</summary>
    FLoopList: TList;
    FCurrentLoop: Integer;
    FCurrentCom: Integer;
    FFilename: string;
    FFilePath: string;
    FRegisted: Boolean;
    procedure SetFilename(const Value: string);
    procedure SetFilePath(const Value: string);
    procedure FunWhile(Cmd: TArrayOfString; EndCmdIdx: Integer);                //循环开始
    procedure FunLoop(Cmd: TArrayOfString; BeginCmdIdx: Integer);               //循环结束
    procedure FunMoveData(Cmd: TArrayOfString);
  protected
    FOpened: Boolean;
    /// <summary>打开一个文件名称打开文档</summary>
    procedure Open(Filename: string); virtual; abstract;
    /// <summary>通过模板新建一个文件</summary>
    procedure New(Filename: string); virtual; abstract;
    /// <summary>执行独立命令</summary>
    /// <param name="Cmd">命令及其参数</param>
    procedure DoSpeicalCommand(Cmd: TArrayOfString); virtual; abstract;
    /// <summary>系统准备，即将各循环及内部变量置零</summary>
    procedure Prepared; virtual; abstract;
  public
    constructor Create; virtual;
    destructor Destroy; virtual;
    /// <summary>通过文件名，自动创建输出函数</summary>
    class function OfficeExport(AFilename: string): TOfficeExport; static;
    /// <summary>注册一个数据库查询结果集</summary>
    /// <param name="Prefix">数据前缀</param>
    /// <param name="ADataSet">数据集</param>
    procedure RegTable(Prefix: string; ADataSet: TDataSet);
    /// <summary>注册一个数据集</summary>
    /// <param name="Prefix">数据前缀</param>
    /// <param name="ADataSet<see>TVonTable</see>">数据集</param>
    procedure RegData(Prefix: string; ADataSet: TVonTable);
    /// <summary>注册执行命令</summary>
    /// <param name="Cmd">命令及其参数</param>
    procedure RegCommand(Cmd: array of string);
    /// <summary>打印当前文件</summary>
    procedure Print; virtual; abstract;
    /// <summary>另存当前文件，如文件名不写则表示用原文件名存储</summary>
    procedure SaveFile(AFilename: string = ''); virtual; abstract;
    /// <summary>关闭当前word文档</summary>
    procedure Close; virtual; abstract;
    /// <summary>导出所有注册项目名称</summary>
    procedure WriteReg;
    /// <summary>执行独立命令</summary>
    /// <param name="Cmd">命令及其参数</param>
    procedure DoCommand(Cmd: TArrayOfString);
    /// <summary>按顺序执行所有命令</summary>
    procedure Execute; virtual;
    /// <summary>保护文档结果</summary>
    procedure Protect(PWD: string); virtual; abstract;
    /// <summary>清除所有注册命令及注册数据信息</summary>
    procedure Clear; virtual;
    procedure Debug;
  published
    property Filename: string read FFilename write SetFilename;
    property FilePath: string read FFilePath write SetFilePath;
    property Registed: Boolean read FRegisted;
    /// <summary>文件是否已经打开</summary>
    property Opened: Boolean read FOpened;
  end;

  TExcelExport = class(TOfficeExport)
  private
    FExcelApp: TExcelApplication;
    FExcelBook: TExcelWorkbook;
    FExcelSheet: TExcelWorksheet;
    LCID: Integer;
    FRowOffset: array[1..10] of Integer;
    FColOffset: array[1..10] of Integer;
    /// <summary>单一显示数据源</summary>
    procedure WriteONLYData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>多行填充数据源</summary>
    procedure WriteROWSData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>多列填充数据源</summary>
    procedure WriteCOLSData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>多行扩展数据源</summary>
    procedure WriteEROWData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>多列扩展数据源</summary>
    procedure WriteECOLData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>多页显示数据源</summary>
    procedure WritePAGEData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>母页行段数据源</summary>
    procedure WriteRBLKData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    /// <summary>母页行段数据源</summary>
    procedure WriteCBLKData(Prefix: string; Page: Integer; ADataSet: TDataSet);
    function GetCurrentSheet: TExcelWorksheet;
  protected
    /// <summary>打开一个文件名称打开文档</summary>
    procedure Open(Filename: string); override;
    /// <summary>通过模板新建一个文件</summary>
    procedure New(Filename: string); override;
    /// <summary>执行独立命令</summary>
    /// <param name="Cmd">命令及参数</param>
    procedure DoSpeicalCommand(Cmd: TArrayOfString); override;
    procedure Execute; override;
    procedure Prepared; override;
    procedure FunWrite(Cmd: TArrayOfString);                           //写数据
    procedure FunCopy(Cmd: TArrayOfString);                            //复制一个区域或页面
    procedure FunInsertRow(Cmd: TArrayOfString);                       //插入行
    procedure FunInsertCol(Cmd: TArrayOfString);                       //插入列
    procedure FunDelRow(Cmd: TArrayOfString);                          //删除行
    procedure FunDelCol(Cmd: TArrayOfString);                          //删除列
    procedure FunClearOffset(Cmd: TArrayOfString);                     //删除浮动行
  public
    constructor Create; override;
    destructor Destroy; override;
    /// <summary>打印当前文件</summary>
    procedure Print; override;
    /// <summary>另存当前文件，如文件名不写则表示用原文件名存储</summary>
    procedure SaveFile(AFilename: string = ''); override;
    /// <summary>关闭当前word文档</summary>
    procedure Close; override;
    /// <summary>保护文档结果</summary>
    procedure Protect(PWD: string); override;
  published
    /// <summary>当前工作表</summary>
    property CurrentSheet: TExcelWorksheet read GetCurrentSheet;
  end;

  TWordExport = class(TOfficeExport)
  private
    FWordApp: TWordApplication;
    FWordBook: TWordDocument;
    /// <summary>单一显示数据源</summary>
    procedure WriteONLYData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>多行填充数据源</summary>
    procedure WriteROWSData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>多列填充数据源</summary>
    procedure WriteCOLSData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>多行扩展数据源</summary>
    procedure WriteEROWData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>多列扩展数据源</summary>
    procedure WriteECOLData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>多页显示数据源</summary>
    procedure WritePAGEData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>母页行段数据源</summary>
    procedure WriteRBLKData(Prefix: string; ADataSet: TCustomADODataSet);
    /// <summary>母页行段数据源</summary>
    procedure WriteCBLKData(Prefix: string; ADataSet: TCustomADODataSet);
    function GetCurrentBook: TWordDocument;
  protected
    /// <summary>打开一个文件名称打开文档</summary>
    procedure Open(Filename: string); override;
    /// <summary>通过模板新建一个文件</summary>
    procedure New(Filename: string); override;
    /// <summary>执行独立命令</summary>
    /// <param name="Cmd">命令及参数</param>
    procedure DoSpeicalCommand(Cmd: TArrayOfString); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    /// <summary>打印当前文件</summary>
    procedure Print; override;
    /// <summary>另存当前文件，如文件名不写则表示用原文件名存储</summary>
    procedure SaveFile(AFilename: string = ''); override;
    /// <summary>关闭当前word文档</summary>
    procedure Close; override;
  published
    property CurrentBook: TWordDocument read GetCurrentBook;
  end;

  THtmlExport = class(TOfficeExport)
  private
    FHtml: TStringList;
    procedure WriteDataRow(Idx: Integer; Data: TDataSet);
    procedure WriteDataERow(Idx: Integer; Data: TDataSet);
    procedure WriteTableRow(Idx: Integer; Table: TVonTable);
    procedure WriteTableERow(Idx: Integer; Table: TVonTable);
    function WriteData(S: string; Data: TDataSet): string;
    procedure FunUpdateRow(Cmd: TArrayOfString);
  protected
    /// <summary>打开一个文件名称打开文档</summary>
    procedure Open(Filename: string); override;
    /// <summary>通过模板新建一个文件</summary>
    procedure New(Filename: string); override;
    /// <summary>执行独立命令</summary>
    /// <param name="Cmd">命令及参数</param>
    procedure DoSpeicalCommand(Cmd: TArrayOfString); override;
    /// <summary>执行前系统参数及变量初始化</summary>
    procedure Prepared; override;
    /// <summary>写数据命令</summary>
    /// <param name="Cmd">命令及参数</param>
    procedure FunWrite(Cmd: TArrayOfString);                           //写数据
  public
    constructor Create; override;
    destructor Destroy; override;
    /// <summary>打印当前文件</summary>
    procedure Print; override;
    /// <summary>另存当前文件，如文件名不写则表示用原文件名存储</summary>
    procedure SaveFile(AFilename: string = ''); override;
    /// <summary>关闭当前word文档</summary>
    procedure Close; override;
  end;

  TJSExport = class(TOfficeExport)
  private
    FHtml: TStringList;
  protected
    /// <summary>打开一个文件名称打开文档</summary>
    procedure Open(Filename: string); override;
    /// <summary>通过模板新建一个文件</summary>
    procedure New(Filename: string); override;
    /// <summary>执行独立命令</summary>
    /// <param name="Cmd">命令及参数</param>
    procedure DoSpeicalCommand(Cmd: TArrayOfString); override;
    /// <summary>执行前系统参数及变量初始化</summary>
    procedure Prepared; override;
    /// <summary>写数据命令</summary>
    /// <param name="Cmd">命令及参数</param>
    procedure FunWrite(Cmd: TArrayOfString);                           //写数据
  public
    constructor Create; override;
    destructor Destroy; override;
    /// <summary>打印当前文件</summary>
    procedure Print; override;
    /// <summary>另存当前文件，如文件名不写则表示用原文件名存储</summary>
    procedure SaveFile(AFilename: string = ''); override;
    /// <summary>关闭当前word文档</summary>
    procedure Close; override;
  end;

implementation

uses StrUtils, UDlgBrowser;

var
  NullParam: OleVariant;

{ TOfficeExport }

procedure TOfficeExport.Clear;
begin
  FRegList.Clear;
  FLoopList.Clear;
  FCommandList.Clear;
  FCurrentLoop:= 0;
  FCurrentCom:= 0;
  FFilename:= '';
  FFilePath:= '';
  FRegisted:= False;
end;

constructor TOfficeExport.Create;
begin
  FRegList:= TStringList.Create;
  FCommandList:= TVonArraySetting.Create;
  FLoopList:= TList.Create;
end;

procedure TOfficeExport.Debug;
var
  S: string;
  I: Integer;
begin
  for I := 0 to FCommandList.Count - 1 do
    S:= S + #13#10 + IntToStr(I) + ' : ' + FCommandList[I, 0] + '(' +
      IntToStr(Integer(FCommandList.Data[I])) + ')';
  ShowMessage(S);
end;

destructor TOfficeExport.Destroy;
begin
  FLoopList.Free;
  FCommandList.Free;
  FRegList.Free;
end;

procedure TOfficeExport.DoCommand(Cmd: TArrayOfString);
begin
  WriteLog(LOG_DEBUG, 'TOfficeExport', Cmd[0]);
  if Cmd[0] = 'WHILE' then begin
    if FCurrentLoop > FCurrentCom then begin              //后面的循环结束，删除当前的循环次数
      FLoopList.Delete(FLoopList.Count - 1);
      FCurrentLoop:= FCurrentCom;
    end else if FCurrentLoop < FCurrentCom then begin     //新循环开始，添加一个
      FLoopList.Add(nil);
      FCurrentLoop:= FCurrentCom;
    end else
      FLoopList[FLoopList.Count - 1]:= Pointer(Integer(FLoopList[FLoopList.Count - 1]) + 1);
    FunWhile(Cmd, Integer(FCommandList.Data[FCurrentCom]));       //循环开始
  end else if Cmd[0] = 'LOOP' then FunLoop(Cmd, Integer(FCommandList.Data[FCurrentCom]))    //循环结束
  else if Cmd[0] = 'MOVE' then FunMoveData(Cmd)         //移动数据游标
  else DoSpeicalCommand(Cmd);
end;

procedure TOfficeExport.Execute;
var
  I: Integer;
begin
  FCurrentCom:= 0;
  FCurrentLoop:= -1;
  FLoopList.Clear;
  Prepared;
  WriteLog(LOG_DEBUG, 'TOfficeExport', ' ===================== BEGIN +++++++++++++++++');
  while FCurrentCom < FCommandList.Count do begin
    DoCommand(FCommandList.GetRow(FCurrentCom));
    Inc(FCurrentCom);
  end;
end;

procedure TOfficeExport.FunLoop(Cmd: TArrayOfString; BeginCmdIdx: Integer);
var
  I, Idx: Integer;
  AData: TDataSet;
  ATable: TVonTable;
begin
  for I := 1 to Length(Cmd) - 1 do begin
    Idx:= FRegList.IndexOfName(Cmd[I]);
    if FRegList.ValueFromIndex[Idx][1] = '@' then
      TDataSet(FRegList.Objects[Idx]).Next
    else begin
      FRegList.ValueFromIndex[Idx]:= IntToStr(StrToInt(FRegList.ValueFromIndex[Idx]) + 1);
      if StrToInt(FRegList.ValueFromIndex[Idx]) >= TVonTable(FRegList.Objects[Idx]).RowCount then
        FRegList.ValueFromIndex[Idx]:= IntToStr(TVonTable(FRegList.Objects[Idx]).RowCount);
    end;
  end;
  FCurrentCom:= BeginCmdIdx - 1;
end;

procedure TOfficeExport.FunMoveData(Cmd: TArrayOfString);
var
  Idx, tbIdx: Integer;
  AData: TDataSet;
  ATable: TVonTable;
begin
  Idx:= FRegList.IndexOfName(Cmd[1]);
  if FRegList.ValueFromIndex[Idx] = '@' then begin
    if Cmd[2] = 'FIRST' then TDataSet(FRegList.Objects[Idx]).First
    else if Cmd[2] = 'NEXT' then TDataSet(FRegList.Objects[Idx]).Next
    else if Cmd[2] = 'PRIOR' then TDataSet(FRegList.Objects[Idx]).Prior
    else if Cmd[2] = 'LAST' then TDataSet(FRegList.Objects[Idx]).Last;
  end else begin
    ATable:= TVonTable(FRegList.Objects[Idx]);
    tbIdx:= StrToInt(FRegList.ValueFromIndex[Idx]);
    if Cmd[2] = 'FIRST' then tbIdx:= 0
    else if(Cmd[2] = 'NEXT')and(tbIdx < ATable.RowCount - 1)then Inc(tbIdx)
    else if(Cmd[2] = 'PRIOR')and(tbIdx > 0)then Dec(tbIdx)
    else if(Cmd[2] = 'LAST')and(tbIdx < ATable.RowCount - 1)then tbIdx:= ATable.RowCount - 1;
  end;
end;

procedure TOfficeExport.FunWhile(Cmd: TArrayOfString; EndCmdIdx: Integer);
var
  Idx, orgCmd: Integer;
  AData: TDataSet;
  ATable: TVonTable;
begin     //['WHILE',<Prefix>,<condition>]        //循环开始
  orgCmd:= FCurrentCom;
  FCurrentCom:= EndCmdIdx;
  if Cmd[1] = '' then begin  //['WHILE','',<condition>]       //根据循环次数判定是否结束
    if Integer(FLoopList[FLoopList.Count - 1]) >= StrToInt(Cmd[2]) then Exit;
  end else begin
    Idx:= FRegList.IndexOfName(Cmd[1]);
    if FRegList.ValueFromIndex[Idx] = '@' then
      AData:= TDataSet(FRegList.Objects[Idx])
    else ATable:= TVonTable(FRegList.Objects[Idx]);
    if Cmd[2] = 'NEOF' then begin //, NBOF=not BOF, BOF=BOF, EOF=BOF,
      {$region 'NEOF=not EOF，即到尾结束'}
      if Assigned(AData)and(AData.Eof) then Exit
      else if Assigned(ATable)and(ATable.RowCount <= StrToInt(FRegList.ValueFromIndex[Idx])) then Exit;
      {$endregion}
    end else if Cmd[2] = 'NBOF' then begin //NEOF=not EOF, , BOF=BOF, EOF=BOF,
      {$region 'NBOF=not BOF，即到首结束'}
      if Assigned(AData)and(AData.Bof) then Exit
      else if Assigned(ATable)and(0 = StrToInt(FRegList.ValueFromIndex[Idx])) then Exit;
      {$endregion}
    end else if Cmd[2] = 'EOF' then begin //NEOF=not EOF, NBOF=not BOF, BOF=BOF, EOF=BOF,
      {$region 'EOF=BOF，即不到尾结束'}
      if Assigned(AData)and(not AData.Eof) then Exit
      else if Assigned(ATable)and(ATable.RowCount > Integer(FLoopList[FLoopList.Count - 1])) then Exit;
      {$endregion}
    end else if Cmd[2] = 'BOF' then begin //NEOF=not EOF, NBOF=not BOF, BOF=BOF, EOF=BOF,
      {$region 'BOF=BOF，即不到首结束'}
      if Assigned(AData)and(not AData.Bof) then Exit
      else if Assigned(ATable)and(0 < Integer(FLoopList[FLoopList.Count - 1])) then Exit;
      {$endregion}
    end;
  end;
  FCurrentCom:= orgCmd;
  FLoopList[FLoopList.Count - 1]:= Pointer(Integer(FLoopList[FLoopList.Count - 1]) + 1);
end;

class function TOfficeExport.OfficeExport(AFilename: string): TOfficeExport;
var
  FileExt: string;
  function OpenExportor(Exportor: TOfficeExport; ExportFilename: string): TOfficeExport;
  begin
    Result:= Exportor;
    Result.Filename:= ExportFilename;
    Result.Open(AFilename);
  end;
  function NewExportor(Exportor: TOfficeExport; ExportFilename: string): TOfficeExport;
  begin
    Result:= Exportor;
    Result.Filename:= ExportFilename;
    Result.New(AFilename);
  end;
begin
  FileExt:= UpperCase(ExtractFileExt(AFilename));
  if FileExt = '.XLS' then
    Result:= OpenExportor(TExcelExport.Create, AFilename);
  if FileExt = '.XLSX' then
    Result:= OpenExportor(TExcelExport.Create, AFilename);
  if FileExt = '.XLT' then
    Result:= NewExportor(TExcelExport.Create, ChangeFileExt(AFilename, '.xls'));
  if FileExt = '.XLTX' then
    Result:= NewExportor(TExcelExport.Create, ChangeFileExt(AFilename, '.xls'));

  if FileExt = '.DOC' then
    Result:= OpenExportor(TWordExport.Create, AFilename);
  if FileExt = '.DOCX' then
    Result:= OpenExportor(TWordExport.Create, AFilename);
  if FileExt = '.DOT' then
    Result:= NewExportor(TWordExport.Create, ChangeFileExt(AFilename, '.doc'));
  if FileExt = '.DOTX' then
    Result:= NewExportor(TWordExport.Create, ChangeFileExt(AFilename, '.doc'));

  if FileExt = '.HTM' then
    Result:= NewExportor(THtmlExport.Create, AFilename);
  if FileExt = '.HTML' then
    Result:= NewExportor(THtmlExport.Create, AFilename);
end;

procedure TOfficeExport.RegCommand(Cmd: array of string);
var
  FCurrCmdList: TList;
begin
  if Length(Cmd) = 0 then raise Exception.Create('不允许空命令信息注册。');
  Cmd[0]:= UpperCase(Trim(Cmd[0]));
  if Cmd[0] = 'WHILE' then FLoopList.Add(Pointer(FCommandList.AppendRow(Cmd)))
  else if Cmd[0] = 'LOOP' then begin
    if FLoopList.Count = 0 then
      raise Exception.Create('Command "Loop" not found "while".');
    FCommandList.Data[Integer(FLoopList[FLoopList.Count - 1])]:=
      Pointer(FCommandList.AppendRow(Cmd, FLoopList[FLoopList.Count - 1]));
    FLoopList.Delete(FLoopList.Count - 1);
  end else FCommandList.AppendRow(Cmd);
end;

procedure TOfficeExport.RegData(Prefix: string; ADataSet: TVonTable);
begin
  FRegList.AddObject(Prefix + '=0', ADataSet);
  FRegisted:= True;
end;

procedure TOfficeExport.RegTable(Prefix: string; ADataSet: TDataSet);
begin
  FRegList.AddObject(Prefix + '=@', ADataSet);
  FRegisted:= True;
end;

procedure TOfficeExport.SetFilename(const Value: string);
begin
  FFilename := ExtractFileName(Value);
  FFilePath := ExtractFilePath(Value);
end;

procedure TOfficeExport.SetFilePath(const Value: string);
begin
  FFilePath := Value;
end;

procedure TOfficeExport.WriteReg;
var
  I, J: Integer;
  Params: TVonList;
begin
  Params:= TVonList.Create;
  for I := 0 to FRegList.Count - 1 do
    case FRegList.ValueFromIndex[I][1] of
    '@': with TDataSet(FRegList.Objects[I]) do
        for J := 0 to Fields.Count - 1 do
          Params.Add(FRegList.Names[I] + '_' + Fields[J].FieldName);
    else with TVonTable(FRegList.Objects[I]) do
        for J := 0 to ColCount - 1 do
          Params.Add(FRegList.Names[I] + '_' + IntToStr(J));
    end;
//  DoSpeicalCommand('WRITETEXT', Params);
  Params.Free;
end;

{ TExcelExport }

type
  TData = class
    D: ExcelRange;
  end;

procedure TExcelExport.Close;
begin
  if not FOpened then Exit;
  FExcelBook.Close;
  FOpened:= False;
end;

constructor TExcelExport.Create;
begin
  inherited;
  FExcelApp:= TExcelApplication.Create(nil);
  FExcelBook:= TExcelWorkBook.Create(nil);
  FExcelSheet:= TExcelWorksheet.Create(nil);
  LCID := GetUserDefaultLCID();
end;

destructor TExcelExport.Destroy;
begin
  FExcelApp.Quit;
  FExcelApp.Disconnect;
  FExcelBook.Free;
  FExcelApp.Free;
  inherited;
end;

procedure TExcelExport.DoSpeicalCommand(Cmd: TArrayOfString);
var
  I: Integer;
  ole: OleVariant;
begin
  if Cmd[0] = 'INSROW' then FunInsertRow(Cmd)           //插入行
  else if Cmd[0] = 'INSCOL' then FunInsertCol(Cmd)      //插入列
  else if Cmd[0] = 'DELROW' then FunDelRow(Cmd)         //删除行
  else if Cmd[0] = 'DELCOL' then FunDelCol(Cmd)         //删除列
  else if Cmd[0] = 'COPY' then FunCopy(Cmd)             //复制一个区域或页面
  else if Cmd[0] = 'WRITE' then FunWrite(Cmd)           //写入数据
  else if Cmd[0] = 'OFFSET' then FunClearOffset(Cmd)    //设置浮动值
  else raise Exception.Create('Cannot execute commmand "' + Cmd[0] + '"');
end;

procedure TExcelExport.Execute;
begin
  FExcelApp.ScreenUpdating[0]:= False;
  inherited;
  FExcelApp.ScreenUpdating[0]:= True;
end;

procedure TExcelExport.FunClearOffset(Cmd: TArrayOfString);
begin     //OFFSET C 1 0
  if Length(Cmd) < 3 then
    raise Exception.Create('The command OFFSET syntax is OFFSET C|R <page> <offset>');
  if Cmd[1] = 'C' then FColOffset[StrToInt(Cmd[2])] := StrToInt(Cmd[3])
  else FRowOffset[StrToInt(Cmd[2])] := StrToInt(Cmd[3]);
end;

procedure TExcelExport.FunCopy(Cmd: TArrayOfString);
var
  szPage: Integer;
  szSheet: _Worksheet;

  procedure PasteRange(szRange: ExcelRange; Horizontal: Boolean);
  begin
    szSheet:= (FExcelBook.Worksheets[szPage] as _Worksheet);
    szRange.Copy(NullParam);
    if Horizontal then begin
      FColOffset[szPage]:= szSheet.UsedRange[LCID].Columns.Count;
      if FColOffset[szPage] = 1 then FColOffset[szPage]:= 0;
      FRowOffset[szPage]:= 0;
    end else begin
      FRowOffset[szPage]:= szSheet.UsedRange[LCID].Rows.Count;
      if FRowOffset[szPage] = 1 then FRowOffset[szPage]:= 0;
      FColOffset[szPage]:= 0;
    end;
  end;
begin
  // ['COPY',<CopyKind>,<page>,<params>]          //复制一个区域或页面到指定页面
  // <CopyKind>: HRANG=水平区域复制，后面参数为RECT四点位置即 <page>,'A2','O10'
  //             VRANG=水平区域复制，后面参数为RECT四点位置即 <page>,'A2','O10'
  //             HPAGE=水平单页复制，后面参数为复制页页码 <page>
  //             VPAGE=垂直单页复制，后面参数为复制页页码 <page>
  inherited;
  szPage:= StrToInt(Cmd[2]);
  if Cmd[1] = 'HPAGE' then
    PasteRange((FExcelBook.Worksheets[StrToInt(Cmd[3])] as _Worksheet).UsedRange[LCID], True)
  else if Cmd[1] = 'VPAGE' then
    PasteRange((FExcelBook.Worksheets[StrToInt(Cmd[3])] as _Worksheet).UsedRange[LCID], False)
  else if Cmd[1] = 'HRANG' then
    PasteRange((FExcelBook.Worksheets[StrToInt(Cmd[3])] as _Worksheet).Range[Cmd[4], Cmd[5]], True)
  else if Cmd[1] = 'VRANG' then
    PasteRange((FExcelBook.Worksheets[StrToInt(Cmd[3])] as _Worksheet).Range[Cmd[4], Cmd[5]], False);
  szSheet.Cells.Item[FRowOffset[szPage] + 1, FColOffset[szPage] + 1].Select;
  GetCurrentSheet.Paste(NullParam, NullParam, LCID);
end;

procedure TExcelExport.FunDelCol(Cmd: TArrayOfString);
var
  ws: _Worksheet;
begin     //'DELCOL',<page>,<col>,<count>
  inherited;
  ws:= (FExcelBook.Worksheets[StrToInt(Cmd[1])] as _Worksheet);
  ws.Columns.Item[NullParam, StrToInt(Cmd[2])].Selete;
  ws.Columns.Delete(xlToLeft);
end;

procedure TExcelExport.FunDelRow(Cmd: TArrayOfString);
var
  ws: _Worksheet;
begin     //'DELROW',<page>,<col>,<count>
  inherited;
  ws:= (FExcelBook.Worksheets[StrToInt(Cmd[1])] as _Worksheet);
  ws.Rows.Item[NullParam, StrToInt(Cmd[2])].Selete;
  ws.Rows.Delete(xlUp);
end;

procedure TExcelExport.FunInsertCol(Cmd: TArrayOfString);
var
  ws: _Worksheet;
begin     //'DELCOL',<page>,<col>,<count>
  inherited;
  ws:= (FExcelBook.Worksheets[StrToInt(Cmd[1])] as _Worksheet);
  ws.Columns.Item[NullParam, StrToInt(Cmd[2])].Selete;
  ws.Columns.Insert(xlToRight, xlFormatFromLeftOrAbove);
end;

procedure TExcelExport.FunInsertRow(Cmd: TArrayOfString);
var
  ws: _Worksheet;
begin     //'DELROW',<page>,<col>,<count>
  inherited;
  ws:= (FExcelBook.Worksheets[StrToInt(Cmd[1])] as _Worksheet);
  ws.Rows.Item[NullParam, StrToInt(Cmd[2])].Selete;
  ws.Rows.Insert(xlDown, xlFormatFromLeftOrAbove);
end;

procedure TExcelExport.FunWrite(Cmd: TArrayOfString);
var
  Idx, orgCmd: Integer;
  AData: TDataSet;
  ATable: TVonTable;
begin
// ['WRITE',<Prefix>,<page>,<ExportTableKind>]  //写数据
  inherited;
  Idx:= FRegList.IndexOfName(Cmd[1]);
  if FRegList.ValueFromIndex[Idx] = '@' then
    AData:= TDataSet(FRegList.Objects[Idx])
  else ATable:= TVonTable(FRegList.Objects[Idx]);
  if Cmd[3] = 'ONLY' then WriteONLYData(Cmd[1], StrToInt(Cmd[2]), AData);
  if Cmd[3] = 'EROW' then WriteEROWData(Cmd[1], StrToInt(Cmd[2]), AData);
  if Cmd[3] = 'ROWS' then WriteROWSData(Cmd[1], StrToInt(Cmd[2]), AData);
  if Cmd[3] = 'ECOL' then WriteECOLData(Cmd[1], StrToInt(Cmd[2]), AData);
  if Cmd[3] = 'COLS' then WriteCOLSData(Cmd[1], StrToInt(Cmd[2]), AData);
end;

function TExcelExport.GetCurrentSheet: TExcelWorksheet;
begin
  FExcelSheet.ConnectTo(FExcelApp.ActiveSheet as _WorkSheet);
  Result:= FExcelSheet;
end;

procedure TExcelExport.New(Filename: string);
begin
  FExcelApp.Connect;
  FExcelApp.Visible[0]:= True;
  FExcelBook.ConnectTo(FExcelApp.Workbooks.Add(Filename, 0));
  FOpened:= True;
end;

procedure TExcelExport.Open(Filename: string);
begin
  FExcelApp.Connect;
  FExcelApp.Visible[0]:= True;
  FExcelBook.ConnectTo(FExcelApp.Workbooks.Open(Filename, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, 0));
//  function Open(const Filename: WideString; UpdateLinks: OleVariant;
//      ReadOnly: OleVariant; Format: OleVariant; Password: OleVariant;
//      WriteResPassword: OleVariant; IgnoreReadOnlyRecommended: OleVariant;
//      Origin: OleVariant; Delimiter: OleVariant; Editable: OleVariant;
//      Notify: OleVariant; Converter: OleVariant; AddToMru: OleVariant;
//      Local: OleVariant; CorruptLoad: OleVariant; lcid: Integer)
//      : ExcelWorkbook; safecall;
  FExcelSheet.ConnectTo(FExcelApp.ActiveSheet as _WorkSheet);
  FOpened:= True;
end;

procedure TExcelExport.Prepared;
var
  I: Integer;
begin
  for I := 1 to 10 do begin
    FRowOffset[i]:= 0;
    FColOffset[i]:= 0;
  end;
end;

procedure TExcelExport.Print;
begin
  if not FOpened then Exit;
//  PrintOut(From: OleVariant; To_: OleVariant; Copies: OleVariant;
//      Preview: OleVariant; ActivePrinter: OleVariant; PrintToFile: OleVariant;
//      Collate: OleVariant; PrToFileName: OleVariant): OleVariant; dispid 1772;
  OLE_Excel_TLB.Window(FExcelApp.ActiveSheet).PrintOut(1, 1, 1,
    NullParam, NullParam, NullParam, NullParam, NullParam);
end;

procedure TExcelExport.Protect(PWD: string);
var
  I: Integer;
  szOle: OleVariant;
begin
  inherited;
  for I := 1 to FExcelApp.ActiveWorkbook.Sheets.Count do begin
    szOle:= FExcelApp.ActiveWorkbook.Sheets.Item[I];
    szOle.Protect(PWD, true, true, true, true, true, EmptyParam, EmptyParam,
      EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam);
  end;
  FExcelApp.ActiveWorkbook.Protect(PWD, true, true);
end;

procedure TExcelExport.SaveFile(AFilename: string);
var
  szFilename: OleVariant;
begin
  if not FOpened then Exit;
  if AFilename = '' then szFilename:= FilePath + Filename
  else szFilename:= AFilename;
  FExcelApp.ActiveWorkbook.SaveAs(szFilename, xlAddIn, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, 0, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, 0);
//  FExcelApp.ActiveWorkbook.SaveAs(szFilename, xlExcel9795,
//    EmptyParam, EmptyParam, False, False, xlShared, xlLocalSessionChanges,
//    False, EmptyParam, EmptyParam, False, 0);
(*Filename: OleVariant; FileFormat: OleVariant;
      Password: OleVariant; WriteResPassword: OleVariant;
      ReadOnlyRecommended: OleVariant; CreateBackup: OleVariant;
      AccessMode: XlSaveAsAccessMode; ConflictResolution: OleVariant;
      AddToMru: OleVariant; TextCodepage: OleVariant;
      TextVisualLayout: OleVariant; Local: OleVariant; lcid: Integer)*)
//  FExcelApp.Disconnect;
end;

procedure TExcelExport.WriteECOLData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
  ws: _Worksheet;
  lst: TStringList;
  Data: TData;
begin
  Idx:= 0;
  ws:= (FExcelBook.Worksheets[Page] as _Worksheet);
  ws.Select(NullParam, LCID);
  lst:= TStringList.Create;
  with ADataSet do
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, NullParam, NullParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          Data:= TData.Create;
          Data.D:= FExcelBook.Names.Item(J, NullParam, NullParam).RefersToRange;
          lst.AddObject(Fields[I].FieldName, Data);
        end;
  with ADataSet do while not EOF do begin
    for I := 0 to lst.Count - 1 do begin
      if I = 0 then begin
        if Idx > 0 then begin
          ws.Columns.Item[EmptyParam, FColOffset[Page] + TData(lst.Objects[I]).D.Column].Copy(EmptyParam);
          ws.Columns.Item[EmptyParam, FColOffset[Page] + TData(lst.Objects[I]).D.Column + 1].Insert(xlShiftUp, xlFormatFromLeftOrAbove);
          Inc(FColOffset[Page]);
        end;
        Inc(Idx);
        Expanded:= True;
      end;
      ws.Cells.Item[FRowOffset[Page] + TData(lst.Objects[I]).D.Row,
        FColOffset[Page] + TData(lst.Objects[I]).D.Column].Value2:= FieldByName(lst[I]).AsString;
    end;
    Next;
  end;
  for I := 0 to lst.Count - 1 do TData(lst.Objects[I]).Free;
  lst.Free;
end;

procedure TExcelExport.WriteEROWData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
  ws: _Worksheet;
  lst: TStringList;
  Data: TData;
begin
  Idx:= 0;
  ws:= (FExcelBook.Worksheets[Page] as _Worksheet);
  ws.Select(NullParam, LCID);
  lst:= TStringList.Create;
  with ADataSet do
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, NullParam, NullParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          Data:= TData.Create;
          Data.D:= FExcelBook.Names.Item(J, NullParam, NullParam).RefersToRange;
          lst.AddObject(Fields[I].FieldName, Data);
        end;
  with ADataSet do while not EOF do begin
    for I := 0 to lst.Count - 1 do begin
      if I = 0 then begin
        if Idx > 0 then begin
          ws.Rows.Item[FRowOffset[Page] + TData(lst.Objects[I]).D.Row, EmptyParam].Copy(EmptyParam);
          ws.Rows.Item[FRowOffset[Page] + TData(lst.Objects[I]).D.Row + 1, EmptyParam].Insert(xlShiftUp, xlFormatFromLeftOrAbove);
          Inc(FRowOffset[Page]);
        end;
        Inc(Idx);
        Expanded:= True;
      end;
      ws.Cells.Item[FRowOffset[Page] + TData(lst.Objects[I]).D.Row,
        FColOffset[Page] + TData(lst.Objects[I]).D.Column].Value2:= FieldByName(lst[I]).AsString;
    end;
    Next;
  end;
  for I := 0 to lst.Count - 1 do TData(lst.Objects[I]).Free;
  lst.Free;
end;

procedure TExcelExport.WriteRBLKData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
  baseRange: ExcelRange;
begin
  Idx:= -1;
  FExcelSheet.ConnectTo(FExcelApp.ActiveSheet as _Worksheet);
  baseRange:= FExcelSheet.UsedRange[0];
  with ADataSet do while not EOF do begin
    Expanded:= False;
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, NullParam, NullParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          if not Expanded then begin
            Inc(Idx);
            Expanded:= True;
          end;
          if Idx > 0 then
            baseRange.Copy(baseRange.Offset[Idx * baseRange.Rows.Count, 0]);
          FExcelBook.Names.Item(J, NullParam, NullParam).RefersToRange.Offset[Idx * baseRange.Rows.Count, 0].Value2:= Fields[I].AsString;
        end;
    Next;
  end;
end;

procedure TExcelExport.WriteCBLKData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
  baseRange: ExcelRange;
begin
  Idx:= -1;
  FExcelSheet.ConnectTo(FExcelApp.ActiveSheet as _Worksheet);
  baseRange:= FExcelSheet.UsedRange[0];
  with ADataSet do while not EOF do begin
    Expanded:= False;
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, NullParam, NullParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          if not Expanded then begin
            Inc(Idx);
            Expanded:= True;
          end;
          if Idx > 0 then
            baseRange.Copy(baseRange.Offset[0, Idx * baseRange.Columns.Count]);
          FExcelBook.Names.Item(J, NullParam, NullParam).RefersToRange.Offset[0, Idx * baseRange.Columns.Count].Value2:= Fields[I].AsString;
        end;
    Next;
  end;
end;

procedure TExcelExport.WriteCOLSData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J: Integer;
  szRange: ExcelRange;
  ws: _Worksheet;
begin
  with ADataSet do while not EOF do begin
    for I := 0 to Fields.Count - 1 do begin
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, NullParam, NullParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          szRange:= FExcelBook.Names.Item(J, NullParam, NullParam).RefersToRange;
          ws:= (FExcelBook.Worksheets[Page] as _Worksheet);
          ws.Cells.Item[FRowOffset[Page] + szRange.Row,
            FColOffset[Page] + szRange.Column].Value2:= Fields[I].AsString;
          System.Break;
        end;
    end;
    Inc(FColOffset[Page]);
    Next;
  end;
end;

procedure TExcelExport.WriteONLYData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J: Integer;
  szRange: ExcelRange;
  ws: _Worksheet;
begin
  with ADataSet do
    for I := 0 to Fields.Count - 1 do begin
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, NullParam, NullParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          szRange:= FExcelBook.Names.Item(J, NullParam, NullParam).RefersToRange;
          ws:= (FExcelBook.Worksheets[Page] as _Worksheet);
          ws.Cells.Item[FRowOffset[Page] + szRange.Row,
            FColOffset[Page] + szRange.Column].Value2:= Fields[I].AsString;
          System.Break;
        end else WriteLog(LOG_DEBUG, '', FExcelBook.Names.Item(J, NullParam, NullParam).Name_ + ' != ' + Prefix + '_' + Fields[I].FieldName);
    end;
end;

procedure TExcelExport.WritePAGEData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J, Idx: Integer;
  Expanded: Boolean;
begin
  Idx:= -1;
  with ADataSet do while not EOF do begin
    Expanded:= False;
    for I := 0 to Fields.Count - 1 do
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, NullParam, NullParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          if not Expanded then begin
            Inc(Idx);
            Expanded:= True;
          end;
          if Idx > 0 then begin
            //FExcelBook.Sheets.Copy();
          end;
          FExcelBook.Names.Item(J, NullParam, NullParam).RefersToRange.Offset[Idx, 0].Value2:= Fields[I].AsString;
        end;
    Next;
  end;
end;

procedure TExcelExport.WriteROWSData(Prefix: string; Page: Integer; ADataSet: TDataSet);
var
  I, J: Integer;
  szRange: ExcelRange;
  ws: _Worksheet;
begin
  with ADataSet do while not EOF do begin
    for I := 0 to Fields.Count - 1 do begin
      for J:= 1 to FExcelBook.Names.Count do
        if FExcelBook.Names.Item(J, NullParam, NullParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
          szRange:= FExcelBook.Names.Item(J, NullParam, NullParam).RefersToRange;
          ws:= (FExcelBook.Worksheets[Page] as _Worksheet);
          ws.Cells.Item[FRowOffset[Page] + szRange.Row,
            FColOffset[Page] + szRange.Column].Value2:= Fields[I].AsString;
          System.Break;
        end;
    end;
    Inc(FRowOffset[Page]);
    Next;
  end;
end;

{ TWordExport }

procedure TWordExport.Close;
begin
  if not FOpened then Exit;
  FWordBook.Close;
  FOpened:= False;
end;

constructor TWordExport.Create;
begin
  inherited;
  FWordApp:= TWordApplication.Create(nil);
  FWordBook:= TWordDocument.Create(nil);
end;

destructor TWordExport.Destroy;
begin
  FWordBook.Free;
  FWordApp.Disconnect;
  FWordApp.Free;
  inherited;
end;

procedure TWordExport.DoSpeicalCommand(Cmd: TArrayOfString);
var
  I: Integer;
begin
//  if Cmd = 'WRITETEXT' then
//    FWordApp.Selection.Range.Text:= Params.Text
end;

function TWordExport.GetCurrentBook: TWordDocument;
begin
  Result:= FWordBook;
end;

procedure TWordExport.New(Filename: string);
var
  szFile: OleVariant;
  NewTemplate, DocumentType, Visible: OleVariant;
begin
  FWordApp.Connect;
  FWordApp.Visible:= True;
  szFile:= Filename;
  FWordBook.ConnectTo(FWordApp.Documents.Add(szFile, NewTemplate, DocumentType, Visible));
  FOpened:= True;
end;

procedure TWordExport.Open(Filename: string);
var
  szFile: OleVariant;
begin
  FWordApp.Connect;
  FWordApp.Visible:= True;
  szFile:= Filename;
  FWordBook.ConnectTo(FWordApp.Documents.Open(szFile, NullParam, NullParam,
    NullParam, NullParam, NullParam, NullParam, NullParam, NullParam,
    NullParam, NullParam, NullParam, NullParam, NullParam, NullParam, NullParam));
  FOpened:= True;
end;

procedure TWordExport.Print;
begin
  if not FOpened then Exit;
  FWordBook.PrintPreview;
end;

procedure TWordExport.SaveFile(AFilename: string);
var
  szFilename: OleVariant;
begin
  if not FOpened then Exit;
  if AFilename = '' then szFilename:= FilePath + Filename
  else szFilename:= AFilename;
  FWordBook.SaveAs(szFilename);
end;

procedure TWordExport.WriteCBLKData(Prefix: string;
  ADataSet: TCustomADODataSet);
var
  I, lenPrefix: Integer;
  FieldCode: string;
begin
  for I := 1 to FWordBook.Fields.Count do
    with FWordBook.Fields.Item(I) do begin

      lenPrefix:= Length(Prefix);                       //«A_Delivery»
      FieldCode:= System.Copy(Result.Text, lenPrefix + 3, Length(Result.Text) - lenPrefix - 3);
      if System.Copy(Result.Text, 2, lenPrefix) = Prefix then
        Result.Text:= ADataSet.FieldByName(FieldCode).AsString;
  end;

//  Idx:= -1;
//  FExcelSheet.ConnectTo(FExcelApp.ActiveSheet as _Worksheet);
//  baseRange:= FExcelSheet.UsedRange[0];
//  with ADataSet do while not EOF do begin
//    Expanded:= False;
//    for I := 0 to Fields.Count - 1 do
//      for J:= 1 to FExcelBook.Names.Count do
//        if FExcelBook.Names.Item(J, NullParam, NullParam).Name_ = Prefix + '_' + Fields[I].FieldName then begin
//          if not Expanded then begin
//            Inc(Idx);
//            Expanded:= True;
//          end;
//          if Idx > 0 then
//            baseRange.Copy(baseRange.Offset[0, Idx * baseRange.Columns.Count]);
//          FExcelBook.Names.Item(J, NullParam, NullParam).RefersToRange.Offset[0, Idx * baseRange.Columns.Count].Value2:= Fields[I].AsString;
//        end;
//    Next;
//  end;
end;

procedure TWordExport.WriteCOLSData(Prefix: string;
  ADataSet: TCustomADODataSet);
begin

end;

procedure TWordExport.WriteECOLData(Prefix: string;
  ADataSet: TCustomADODataSet);
begin

end;

procedure TWordExport.WriteEROWData(Prefix: string; ADataSet: TCustomADODataSet);
var
  I, J, Idx: Integer;
  D: OleVariant;
  Expanded: Boolean;
  szTable: Table;
  szList: TStringList;
  R_C: PX_Y;
begin
  szList:= TStringList.Create;
  with ADataSet do                     //寻找表格位置索引
    for I := 0 to Fields.Count - 1 do begin
      for J:= 1 to FWordBook.Fields.Count do
        if SameText(FWordBook.Fields.Item(J).Result.Text, '«' + Prefix + '_' + Fields[I].FieldName + '»')then begin
          System.New(R_C);
          R_C.X:= FWordBook.Fields.Item(J).Result.Cells.Item(1).ColumnIndex;
          R_C.Y:= FWordBook.Fields.Item(J).Result.Cells.Item(1).RowIndex;
          szList.AddObject(Fields[I].FieldName, TObject(R_C));
          szTable:= FWordBook.Fields.Item(J).Result.Tables.Item(1);
          System.Break;
        end;
    end;
  J:= 0;
  ADataSet.First;
  with ADataSet do
    while not EOF do begin
      Expanded:= False;
      for I := 0 to Fields.Count - 1 do begin
        Idx:= szList.IndexOf(Fields[I].FieldName);
        if Idx < 0 then Continue;
        R_C:= PX_Y(szList.Objects[Idx]);
        if(not Expanded)then begin
          if J < RecordCount - 1 then begin
            szTable.Cell(R_C.Y + J, R_C.X).Select;
            D:= 1;
            FWordApp.Selection.InsertRowsAbove(D);
          end;
          Expanded:= True;
          Inc(J);
        end;
        szTable.Cell(R_C.Y + J - 1, R_C.X).Range.Text:= Fields[I].AsString;
      end;
      Next;
    end;
  szList.Free;
end;

procedure TWordExport.WriteONLYData(Prefix: string; ADataSet: TCustomADODataSet);
var
  I, lenPrefix: Integer;
  FieldCode: string;
begin
  for I := 1 to FWordBook.Fields.Count do
    with FWordBook.Fields.Item(I) do begin
      lenPrefix:= Length(Prefix);                       //«A_Delivery»
      FieldCode:= System.Copy(Result.Text, lenPrefix + 3, Length(Result.Text) - lenPrefix - 3);
      if System.Copy(Result.Text, 2, lenPrefix) = Prefix then
        Result.Text:= ADataSet.FieldByName(FieldCode).AsString;
  end;
end;

procedure TWordExport.WritePAGEData(Prefix: string;
  ADataSet: TCustomADODataSet);
begin

end;

procedure TWordExport.WriteRBLKData(Prefix: string;
  ADataSet: TCustomADODataSet);
begin

end;

procedure TWordExport.WriteROWSData(Prefix: string;
  ADataSet: TCustomADODataSet);
var
  I, J, Idx, R, C: Integer;
  Expanded: Boolean;
  szTable: Table;
begin
  with ADataSet do begin
    Idx:= RecordCount;
    Last;
    while not BOF do begin
      Expanded:= False;
      for I := 0 to Fields.Count - 1 do
        for J:= 1 to FWordBook.Fields.Count do
          if FWordBook.Fields.Item(J).Result.Text = '«' + Prefix + '_' + Fields[I].FieldName + '»' then begin
            if not Expanded then begin
              Dec(Idx);
              Expanded:= True;
              szTable:= FWordBook.Fields.Item(J).Result.Tables.Item(1);
              R:= FWordBook.Fields.Item(J).Result.Cells.Item(1).RowIndex;
            end;
            C:= FWordBook.Fields.Item(J).Result.Cells.Item(1).ColumnIndex;
            FWordBook.Fields.Item(J).Select;
            szTable.Cell(R + Idx, C).Range.Text:= Fields[I].AsString;
          end else WriteLog(LOG_Debug, 'WriteROWSData',
            FWordBook.Fields.Item(J).Result.Text + ' ? ' + Prefix + '_' + Fields[I].FieldName);
      Prior;
    end;
  end;
end;

{ THtmlExport }

function FirstSubStrIInBuffer(const SubStr: PAnsiChar; const Buffer, BufLen, StartPos: Integer): Integer;
asm
  //eax <-- SubStr
  //edx <-- Buffer
  //ecx <-- BufLen

  //Comment out for speed. In this unit, it is impossible! But if you copy and
  //paste this function to other place, it is safe not comment out following 3
  //blocks

  //SubStr is NULL ?
  //test eax,eax
  //je @@Exit

  //Buffer is NULL ?
  //test edx,edx
  //je @@Exit

  //BufLen <= 0 ?
  //cmp ecx,0
  //jle @@Exit

  //BufLen <= StartPos ?
  cmp ecx,StartPos
  jle @@Exit

  //Save registers
  push esi
  push edi

  mov esi,eax

  mov al,[esi]
  cmp al,0      //terminal char
  je @@NotFound

  mov edi,edx
  add edi,StartPos
  sub ecx,StartPos

@@Prepare:
  mov al,[esi]

@@CompareFirstChar:
  //jecxz @@NotFound, optimize for speed, 2001.11.6
  test ecx,ecx        //to the end of buffer
  jz @@NotFound

  mov ah,[edi]
  inc edi
  dec ecx
  cmp ah,al
  je @@CompareRest
  cmp al,'a'
  jb @@SourceToUpper
  cmp al,'z'
  ja @@CompareFirstChar
  sub al,20h

@@SourceToUpper:
  cmp ah,'a'
  jb @@SecondCompare
  cmp ah,'z'
  ja @@CompareFirstChar
  sub ah,20h

@@SecondCompare:
  cmp ah,al
  jne @@CompareFirstChar

@@CompareRest:
  //save registers
  push esi
  push edi
  push ecx

  //advance pointer
  inc esi

@@CompareStrI:
  //jecxz @@PrepareGoBack, optimize for speed, 2001.11.6
  test ecx,ecx             //to the end of buffer
  jz @@PrepareGoBack

  //lodsb, optimize for speed, 2001.11.6
  mov al,[esi]
  inc esi

  cmp al,0      //terminal char
  je @@Matched
  mov ah,[edi]
  inc edi
  dec ecx
  cmp ah,al
  je @@CompareStrI
  cmp al,'a'
  jb @@SourceToUpperRest
  cmp al,'z'
  ja @@PrepareGoBack
  sub al,20h

@@SourceToUpperRest:
  cmp ah,'a'
  jb @@SecondCompareRest
  cmp ah,'z'
  ja @@PrepareGoBack
  sub ah,20h

@@SecondCompareRest:
  cmp ah,al
  je @@CompareStrI
  jmp @@PrepareGoBack

@@Matched:
  //balance stack
  pop ecx
  pop edi
  pop esi

  mov eax,edi
  sub eax,edx

  //restore registers
  pop edi
  pop esi
  jmp @@Exit1

@@PrepareGoback:
  //restore registers
  pop ecx
  pop edi
  pop esi
  jmp @@Prepare

@@NotFound:
  //restore registers
  pop edi
  pop esi

@@Exit:
  xor eax,eax

@@Exit1:

  dec eax
end;

function FirstCharInBufferNotInQuotes(const C: Char; const Buffer,BufLen,StartPos: Integer): Integer;
asm
  //eax <-- C
  //edx <-- Buffer
  //ecx <-- BufLen

  //Comment out for speed. In this unit, it is impossible! But if you copy and
  //paste this function to other place, it is safe not comment out following 2
  //blocks

  //Buffer is NULL ?
  //test edx,edx
  //je @@Exit

  //BufLen <= 0 ?
  //cmp ecx,0
  //jle @@Exit

  //BufLen <= StartPos ?
  cmp ecx,StartPos
  jle @@Exit

  //save register
  push edi

  mov edi,edx
  add edi,StartPos
  sub ecx,StartPos

@@Compare:
  //jecxz @@NotFound, optimize for speed, 2001.11.6
  test ecx,ecx
  jz @@NotFound

  mov ah,[edi]
  inc edi
  dec ecx
  cmp ah,'"'
  je @@SkipDoubleQuotes
  cmp ah,''''
  je @@SkipSingleQuotes
  cmp ah,al
  jne @@Compare

  mov eax,edi
  sub eax,edx

  //restore register
  pop edi
  jmp @@DecEax

@@SkipDoubleQuotes:
  //jecxz @@NotFound, optimize for speed, 2001.11.6
  test ecx,ecx
  jz @@NotFound

  mov ah,[edi]
  inc edi
  dec ecx
  cmp ah,'"'
  jne @@SkipDoubleQuotes

  //escape ? 2001.11.6
  cmp [edi-2],'\'
  je @@SkipDoubleQuotes

  jmp @@Compare

@@SkipSingleQuotes:
  //jecxz @@NotFound, optimize for speed, 2001.11.6
  test ecx,ecx
  jz @@NotFound

  mov ah,[edi]
  inc edi
  dec ecx
  cmp ah,''''
  jne @@SkipSingleQuotes

  //escape ? 2001.11.6
  cmp [edi-2],'\'
  je @@SkipSingleQuotes

  jmp @@Compare

@@NotFound:
  //restore register
  pop edi

@@Exit:
  xor eax,eax

@@DecEax:
  dec eax
end;

procedure THtmlExport.Close;
begin
//  FHtmlDoc.LoadFromFile();
end;

constructor THtmlExport.Create;
begin
  inherited;
  FHtml:= TStringList.Create;
end;

destructor THtmlExport.Destroy;
begin
  FHtml.Free;
  inherited;
end;

procedure THtmlExport.DoSpeicalCommand(Cmd: TArrayOfString);
begin
  if Cmd[0] = 'WRITE' then FunWrite(Cmd)           //写入数据
  else if Cmd[0] = 'REPLACE' then FunUpdateRow(Cmd)
  else raise Exception.Create('Cannot execute commmand "' + Cmd[0] + '"');
end;

procedure THtmlExport.FunWrite(Cmd: TArrayOfString);
var
  I, Idx: Integer;
  flag, expKind: string;
  AData: TDataSet;
  ATable: TVonTable;

  function GetSetting(setting, keyName: string): string;
  var
    P: PChar;
    function ToNextChar(C: Char): string;
    begin
      Result:= '';
      while(P^ <> '>')and(P^ <> C)do begin
        Result:= Result + P^;
        Inc(P);
      end;
    end;
  begin
    P:= StrPos(PChar(setting), PChar(keyName));
    Result:= '';
    if not Assigned(P) then Exit;
    Inc(P, Length(keyName));
    if P^= '"' then begin Inc(P); Result:= ToNextChar('"'); end
    else if P^= '''' then begin Inc(P); Result:= ToNextChar(''''); end
    else Result:= ToNextChar(' ');
  end;
begin
  I:= 0;
  while I < FHtml.Count do begin
    //<von key="D" expand="row">
    if Copy(Trim(FHtml[I]), 1, 4) = '<von' then begin
      flag:= GetSetting(FHtml[I], ' key=');
      expKind:= GetSetting(FHtml[I], ' expand=');
      Idx:= FRegList.IndexOfName(flag);
      if FRegList.ValueFromIndex[Idx] = '@' then begin
        if SameText(expKind, 'only') then
          WriteDataRow(I, TDataSet(FRegList.Objects[Idx]))
        else if SameText(expKind, 'row') then
          WriteDataRow(I, TDataSet(FRegList.Objects[Idx]))
        else if SameText(expKind, 'erow') then
          WriteDataERow(I, TDataSet(FRegList.Objects[Idx]));
      end else ATable:= TVonTable(FRegList.Objects[Idx]);
    end;
    Inc(I);
  end;
//  ETK_ROWS, ETK_COLS, ETK_EROW, ETK_ECOL, ETK_PAGE, ETK_RBLK, ETK_CBLK
end;

procedure THtmlExport.New(Filename: string);
begin
  FFilename:= ExtractFilePath(Application.ExeName) + 'TEMP\' + ExtractFileName(Filename);
  FHtml.LoadFromFile(Filename);
end;

procedure THtmlExport.Open(Filename: string);
begin
  FFilename:= Filename;
  FHtml.LoadFromFile(Filename);
end;

procedure THtmlExport.Prepared;
begin
//  FHtml.Clear;
end;

procedure THtmlExport.Print;
begin
  SaveFile();
  PrintHtml(FFilename);
//  ShellExecute(Application.Handle, 'open', PChar(FFilename), '', '', SW_SHOW);
end;

procedure THtmlExport.SaveFile(AFilename: string);
begin
  if AFilename = '' then
    FFilename:= ExtractFilePath(Application.ExeName) + 'Temp\' + ExtractFileName(FFilename);
  FHtml.SaveToFile(FFilename);
end;

procedure THtmlExport.FunUpdateRow(Cmd: TArrayOfString);
begin
  FHtml.Text:= StringReplace(FHtml.Text, Cmd[1], Cmd[2], [rfReplaceAll, rfIgnoreCase]);
end;

function THtmlExport.WriteData(S: string; Data: TDataSet): string;
var
  P, orgPos, fieldPos: PChar;
  fldName: string;
  function GetValue(PV: PChar; endChar: char): string;
  begin
    Result:= '';
    while(PV^ <> endChar)and(PV^ <> ' ')and(PV^ <> '>')do begin
      Result:= Result + PV^;
      Inc(PV);
    end;
  end;
begin
  P:= PChar(S);
  fieldPos:= StrPos(P, 'field=') + 6;
  if fieldPos - P < 7 then begin Result:= S; Exit; end;
  if fieldPos^ = '"' then fldName:= GetValue(fieldPos + 1, '"')
  else if fieldPos^ = '''' then fldName:= GetValue(fieldPos + 1, '''')
  else fldName:= GetValue(fieldPos, ' ');
  orgPos:= StrPos(fieldPos, '>');
  SetString(Result, P, orgPos - P);
  if Data.FieldList.IndexOf(fldName) >= 0 then
    Result:= Result + '>' + Data.FieldByName(fldName).AsString + StrPas(orgPos + 1)
  else Result:= Result + '>' + StrPas(orgPos + 1);
end;

procedure THtmlExport.WriteDataERow(Idx: Integer; Data: TDataSet);
var
  currPos, nextPos, I: Integer;
  S, fldName: string;
  P: PChar;
  lst: TStringList;
begin
  FHtml.Delete(Idx);
  S:= FHtml[Idx];
  lst:= TStringList.Create;
  while Trim(FHtml[Idx]) <> '</von>' do begin
    lst.Add(FHtml[Idx]);
    FHtml.Delete(Idx);
  end;
  FHtml.Delete(Idx);
  while not Data.Eof do begin
    for I := 0 to lst.Count - 1 do begin
      FHtml.Insert(Idx, WriteData(lst[I], Data));
      Inc(Idx);
    end;
    Data.Next;
  end;
  lst.Free;
end;

procedure THtmlExport.WriteDataRow(Idx: Integer; Data: TDataSet);
var
  currPos, nextPos: Integer;
  S, fldName: string;
begin
  FHtml.Delete(Idx);
  S:= FHtml[Idx];
  while Trim(S) <> '</von>' do begin
    FHtml[Idx]:= WriteData(S, Data);
    Inc(Idx);
    S:= FHtml[Idx];
  end;
  FHtml.Delete(Idx);
//  Data.Next;
end;

procedure THtmlExport.WriteTableERow(Idx: Integer; Table: TVonTable);
var
  currPos, nextPos, I, tableIdx, fldIdx: Integer;
  S, fldName: string;
  P: PChar;
  lst: TStringList;
begin
  FHtml.Delete(Idx);
  S:= FHtml[Idx];
  lst:= TStringList.Create;
  while Trim(FHtml[Idx]) <> '</von>' do begin
    lst.Add(FHtml[Idx]);
    FHtml.Delete(Idx);
  end;
  FHtml.Delete(Idx);
  tableIdx:= 0;
  while tableIdx < Table.RowCount do begin
    for I := 0 to lst.Count - 1 do begin
      S:= lst[I];
      FHtml.Insert(Idx, S);
      Inc(Idx);
    end;
    Inc(tableIdx);
  end;
  lst.Free;
end;

procedure THtmlExport.WriteTableRow(Idx: Integer; Table: TVonTable);
begin

end;

{ TJSExport }

procedure TJSExport.Close;
begin

end;

constructor TJSExport.Create;
begin
  inherited;
  FHtml:= TStringList.Create;
end;

destructor TJSExport.Destroy;
begin
  FHtml.Free;
  inherited;
end;

procedure TJSExport.DoSpeicalCommand(Cmd: TArrayOfString);
begin

end;

procedure TJSExport.FunWrite(Cmd: TArrayOfString);
begin

end;

procedure TJSExport.New(Filename: string);
begin
  FFilename:= ExtractFilePath(Application.ExeName) + 'TEMP\' + ExtractFileName(Filename);
  FHtml.LoadFromFile(Filename);
end;

procedure TJSExport.Open(Filename: string);
begin

end;

procedure TJSExport.Prepared;
begin

end;

procedure TJSExport.Print;
begin

end;

procedure TJSExport.SaveFile(AFilename: string);
begin
  if AFilename = '' then
    FFilename:= ExtractFilePath(Application.ExeName) + 'Temp\' + ExtractFileName(FFilename);
  FHtml.SaveToFile(FFilename);
end;

end.
